home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir44 / dungn32.zip / GAME.FOR < prev    next >
Text File  |  1994-10-08  |  12KB  |  309 lines
  1. C Command loop, initialization for DUNGEON
  2. C
  3. C COPYRIGHT 1980, 1990, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA.
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C 17-Sep-94     RMS     Fixed TELL/parse fail bug.  Fixed VMS/UNIX
  8. C                       compatibility problem.
  9. C 30-Jan-94     RMS     Fixed bugs from MS DOS port.
  10. C 30-Jun-92     RMS     Changed file names to lower case.
  11. C
  12. C GAME- Main command loop
  13. C
  14. C Declarations
  15. C
  16.       SUBROUTINE GAME
  17.       IMPLICIT INTEGER (A-Z)
  18.       INCLUDE 'dparam.for'
  19.       LOGICAL RMDESC,VAPPLI,AAPPLI,OBJACT
  20.       LOGICAL F,PARSE,FINDXT,XVEHIC,LIT,PRVLIT
  21.  
  22. C GAME, PAGE 2
  23. C
  24. C Start up, describe current location.
  25. C
  26.       CALL RSPEAK(1)                            ! welcome aboard.
  27.       F=RMDESC(3)                               ! start game.
  28. C
  29. C Now loop, reading and executing commands.
  30. C
  31. 100   WINNER=PLAYER                             ! player moving.
  32.       TELFLG=.FALSE.                            ! assume nothing told.
  33.       IF(PRSCON.LE.1) CALL RDLINE(INBUF,INLNT,1) ! read command.
  34. C
  35.       IF(INBUF(PRSCON:INLNT).NE.'GDT') GO TO 200 ! call on gdt?
  36.       CALL GDT                                  ! yes, invoke.
  37.       PRSCON=1                                  ! force restart.
  38.       GO TO 100                                 ! onward.
  39. C
  40. 200   MOVES=MOVES+1
  41.       SUBLNT=0                                  ! no substrings.
  42.       PRVHER=HERE                               ! save current location.
  43.       PRVLIT=LIT(HERE)                          ! save current lighting.
  44.       PRSWON=PARSE(INBUF,INLNT,.TRUE.)          ! parse input, normal mode.
  45.       IF(.NOT.PRSWON) GO TO 400                 ! parse lose?
  46.       IF(AAPPLI(AACTIO(WINNER))) GO TO 400      ! player handle?
  47.       IF(XVEHIC(1)) GO TO 400                   ! vehicle handle?
  48. C
  49.       IF(PRSA.EQ.TELLW) GO TO 2000              ! tell?
  50. 300   IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY).OR.(PRSO.EQ.POSSE)
  51.      1.OR.(PRSO.EQ.BUNOBJ)) GO TO 900           ! collective object?
  52.       IF(.NOT.VAPPLI(PRSA)) GO TO 400           ! verb ok?
  53.       IF(.NOT.PRVLIT.AND.(HERE.EQ.PRVHER)
  54.      1.AND.LIT(HERE)) F=RMDESC(0)               ! now lit
  55. 350   IF(.NOT.(ECHOF.OR.DEADF).AND.(HERE.EQ.ECHOR)) GO TO 1000
  56.       CALL RAPPLI(RACTIO(HERE))                 ! room action?
  57. C
  58. 400   CALL XENDMV(TELFLG)                       ! do end of move.
  59.       IF(.NOT.LIT(HERE)) PRSCON=1               ! if not lit, restart.
  60.       GO TO 100
  61. C
  62. 900   CALL VALUAC(PRSO)                         ! collective object.
  63.       GO TO 350
  64.  
  65. C GAME, PAGE 3
  66. C
  67. C Special case-- Echo Room.
  68. C If input is not 'ECHO' or a direction, just echo.
  69. C
  70. 1000  CALL RDLINE(INBUF,INLNT,0)                ! read line.
  71.       MOVES=MOVES+1                             ! charge for moves.
  72.       IF(INBUF.NE.'ECHO') GO TO 1100            ! input = echo?
  73. C
  74.       CALL RSPEAK(571)                          ! kill the echo.
  75.       ECHOF=.TRUE.
  76.       OFLAG2(BAR)=OFLAG2(BAR).AND. .NOT.SCRDBT  ! let thief steal bar.
  77.       PRSWON=.TRUE.                             ! fake out parser.
  78.       PRSCON=1                                  ! force new input.
  79.       GO TO 400
  80. C
  81. 1100  IF(INBUF.NE.'BUG') GO TO 1200             ! bug request?
  82.       CALL RSPEAK(913)                          ! wrong, jack.
  83.       GO TO 1000                                ! try again.
  84. C
  85. 1200  IF(INBUF.NE.'FEATURE') GO TO 1300         ! feature request?
  86.       CALL RSPEAK(914)                          ! right, jack.
  87.       GO TO 1000                                ! try again
  88. C
  89. 1300  PRSWON=PARSE(INBUF,INLNT,.FALSE.)         ! parse input, echo mode.
  90.       IF(.NOT.PRSWON .OR. (PRSA.NE.WALKW))
  91.      1GO TO 1400                                ! walk?
  92.       IF(FINDXT(PRSO,HERE)) GO TO 300           ! valid exit?
  93. C
  94. 1400  WRITE(OUTCH,1410) INBUF(1:INLNT)          ! echo input.
  95. 1410  FORMAT(1X,A)
  96.       TELFLG=.TRUE.                             ! indicate output.
  97.       GO TO 1000                                ! more echo room.
  98.  
  99. C GAME, PAGE 4
  100. C
  101. C Special case-- TELL <ACTOR> "NEW COMMAND".
  102. C Note that we cannot be in the Echo Room.
  103. C
  104. 2000  IF(SUBLNT.NE.0) GO TO 2050                ! any substring?
  105.       CALL RSPSUB(946,ODESC2(PRSO))             ! no, joke.
  106.       GO TO 2150                                ! done.
  107. C
  108. 2050  IF(PRSO.NE.OPLAY) GO TO 2100              ! to self?
  109.       WRITE(OUTCH,2060) SUBBUF(1:SUBLNT)        ! ok, tell it.
  110. 2060  FORMAT(' Ok: "',A,'".')
  111.       TELFLG=.TRUE.
  112.       GO TO 2150
  113. C
  114. 2100  IF(OBJACT(X)) GO TO 350                   ! object handle?
  115.       IF((OFLAG2(PRSO).AND.ACTRBT).NE.0) GO TO 2200 ! actor?
  116.       I=602
  117.       IF((OFLAG1(PRSO).AND.VICTBT).NE.0) I=888
  118.       CALL RSPSUB(I,ODESC2(PRSO))               ! no, joke.
  119. 2150  PRSCON=0                                  ! disable cmd stream.
  120.       GO TO 350
  121. C
  122. 2200  SVPRSC=PRSCON                             ! save prscon.
  123.       SVPRSO=PRSO                               ! save prso.
  124.       PRSCON=1                                  ! start of substring.
  125. 2300  WINNER=OACTOR(SVPRSO)                     ! new player.
  126.       HERE=AROOM(WINNER)                        ! new location.
  127.       PRSWON=PARSE(SUBBUF,SUBLNT,.TRUE.)        ! parse command.
  128.       IF(.NOT.PRSWON) GO TO 2600                ! parse succeed?
  129. C
  130.       IF(AAPPLI(AACTIO(WINNER))) GO TO 2400     ! actor handle?
  131.       IF(XVEHIC(1)) GO TO 2400                  ! vehicle handle?
  132.       IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY).OR.(PRSO.EQ.POSSE)
  133.      1.OR.(PRSO.EQ.BUNOBJ)) GO TO 2900  ! collective object?
  134.       IF(.NOT.VAPPLI(PRSA)) GO TO 2400          ! verb handle?
  135. 2350  CALL RAPPLI(RACTIO(HERE))                 ! room action?
  136. 2400  IF(PRSCON-1) 2700,2550,2500               ! parser reset?
  137. 2500  CALL XENDMV(TELFLG)                       ! more to do, end of move.
  138.       GO TO 2300                                ! do next command.
  139. C
  140. 2550  PRSCON=SVPRSC                             ! substring exhausted.
  141.       GO TO 2700                                ! restore state.
  142. C
  143. 2600  IF(OFLAG.NE.0) CALL RSPEAK(604)           ! parse fails, orphans?
  144.       OFLAG=0                                   ! invalidate orphans.
  145. 2700  WINNER=PLAYER                             ! restore state.
  146.       HERE=AROOM(WINNER)
  147.       GO TO 400                                 ! rejoin main loop.
  148. C
  149. 2900  CALL VALUAC(PRSO)                         ! collective object.
  150.       GO TO 2350
  151. C
  152.       END
  153.  
  154. C XENDMV-       Execute end of move functions.
  155. C
  156. C Declarations
  157. C
  158.       SUBROUTINE XENDMV(FLAG)
  159.       IMPLICIT INTEGER (A-Z)
  160.       INCLUDE 'dparam.for'
  161.       LOGICAL F,CLOCKD,FLAG,XVEHIC
  162. C
  163.       IF(.NOT.FLAG) CALL RSPEAK(341)            ! default remark.
  164.       IF(THFACT) CALL THIEFD                    ! thief demon.
  165.       IF(PRSWON.AND..NOT.DEADF) CALL FIGHTD     ! fight demon.
  166.       IF(SWDACT) CALL SWORDD                    ! sword demon.
  167.       IF(PRSWON) F=CLOCKD(X)                    ! clock demon.
  168.       IF(PRSWON) F=XVEHIC(2)                    ! vehicle readout.
  169.       RETURN
  170.       END
  171.  
  172. C XVEHIC- Execute vehicle function
  173. C
  174. C Declarations
  175. C
  176.       LOGICAL FUNCTION XVEHIC(N)
  177.       IMPLICIT INTEGER (A-Z)
  178.       INCLUDE 'dparam.for'
  179.       LOGICAL OAPPLI
  180. C
  181.       XVEHIC=.FALSE.                            ! assume loses.
  182.       AV=AVEHIC(WINNER)                         ! get vehicle.
  183.       IF(AV.NE.0) XVEHIC=OAPPLI(OACTIO(AV),N)
  184.       RETURN
  185.       END
  186.  
  187. C INITFL-- DUNGEON file initialization subroutine
  188. C
  189. C Declarations
  190. C
  191.       LOGICAL FUNCTION INITFL(X)
  192.       IMPLICIT INTEGER (A-Z)
  193.       INCLUDE 'dparam.for'
  194.       LOGICAL PROTCT
  195.       CHARACTER*1 KEDIT
  196.  
  197. C INITFL, PAGE 2
  198. C
  199. C First check for protection violation.
  200. C
  201.       INITFL=.FALSE.                            ! assume init fails.
  202.       IF(PROTCT(X)) GO TO 10000                 ! protection violation?
  203.       WRITE(OUTCH,10100)                        ! yes, throw him off.
  204. 10100 FORMAT(
  205.      1' There appears before you a threatening figure clad all'/
  206.      1' over in heavy black armor.  His legs seem like the massive'/
  207.      2' trunk of the oak tree.  His broad shoulders and helmeted'/
  208.      3' head loom high over your own puny frame, and you realize'/
  209.      4' that his powerful arms could easily crush the very life'/
  210.      5' from your body.  There hangs from his belt a veritable'/
  211.      6' arsenal of deadly weapons: sword, mace, ball and chain'/
  212.      7' dagger, lance, and trident.  He speaks with a commanding'/
  213.      8' voice:'//20X,'"You shall not pass."'//
  214.      9' As he grabs you by the neck all grows dim about you.')
  215.       RETURN
  216. C
  217. C Now restore from existing index file.
  218. C
  219. 10000 OPEN (UNIT=1,FILE='dindx.dat',STATUS='OLD',MODE='READ',
  220.      1FORM='FORMATTED',ACCESS='SEQUENTIAL',ERR=1900)
  221.       READ(1,130) I,J                           ! get version.
  222.       READ(1,125) KEDIT                         ! get minor edit.
  223.       IF((I.NE.VMAJ).OR.(J.NE.VMIN))
  224.      1GO TO 1925                                ! match to ours?
  225. C
  226.       OPEN (UNIT=DBCH,FILE='dtext.dat',STATUS='OLD',MODE='READ',
  227.      1FORM='UNFORMATTED',ACCESS='DIRECT',
  228.      2RECL=RECLNT,ERR=1950)
  229. C
  230.       READ(1,130) MXSCOR,STRBIT,EGMXSC
  231.       READ(1,130) RLNT,RDESC2,RDESC1,REXIT,RACTIO,RVAL,RFLAG
  232.       READ(1,130) XLNT,TRAVEL
  233.       READ(1,130) OLNT,ODESC1,ODESC2,ODESCO,OACTIO,OFLAG1,OFLAG2,
  234.      1OFVAL,OTVAL,OSIZE,OCAPAC,OROOM,OADV,OCAN,OREAD
  235.       READ(1,130) R2LNT,O2,R2
  236.       READ(1,130) CLNT,CTICK,CACTIO
  237.       READ(1,135) CFLAG,CCNCEL
  238.       READ(1,130) VLNT,VILLNS,VPROB,VOPPS,VBEST,VMELEE
  239.       READ(1,130) ALNT,AROOM,ASCORE,AVEHIC,AOBJ,AACTIO,ASTREN,AFLAG
  240.       READ(1,130) MBASE,MLNT,RTEXT
  241. C
  242.       CLOSE (UNIT=1)
  243.       GO TO 1025                                ! init done.
  244. C
  245. 125   FORMAT(A)
  246. 130   FORMAT(I8)
  247. 135   FORMAT(L4)
  248.  
  249. C INITFL, PAGE 3
  250. C
  251. C The internal data base is now established.
  252. C Set up to play the game-- INITFL succeeds.
  253. C
  254. 1025  CALL IDATE(SHOUR,SMIN,SSEC)               ! get date (and toss).
  255.       I=(SHOUR*64)+(SMIN*8)+SSEC                ! first seed
  256.       CALL ITIME(SHOUR,SMIN,SSEC)               ! get time.
  257.       J=(SHOUR*64)+(SMIN*8)+SSEC                ! second seed
  258.       CALL INIRND(I,J)                          ! init random number gen.
  259. C
  260.       WINNER=PLAYER
  261.       THFPOS=OROOM(THIEF)
  262.       BLOC=OROOM(BALLO)
  263.       HERE=AROOM(WINNER)
  264.       LASTIT=AOBJ(PLAYER)
  265. C
  266.       INITFL=.TRUE.
  267.       RETURN
  268. C
  269. C Errors-- INITFL fails.
  270. C
  271. 1900  WRITE(OUTCH,910)                          ! dindx.dat open err
  272.       WRITE(OUTCH,980)
  273.       RETURN
  274. 1925  WRITE(OUTCH,920) I,J,KEDIT,VMAJ,VMIN,VEDIT ! wrong dindx.dat ver
  275.       WRITE(OUTCH,980)
  276.       RETURN
  277. 1950  WRITE(OUTCH,960)                          ! dtext.dat open err
  278.       WRITE(OUTCH,980)
  279.       RETURN
  280. 910   FORMAT(' I can''t open "DINDX.DAT".')
  281. 920   FORMAT(' "DINDX.DAT" is version ',I1,'.',I1,A,'.'/
  282.      1' I require version ',I1,'.',I1,A,'.')
  283. 960   FORMAT(' I can''t open "DTEXT.DAT".')
  284. 980   FORMAT(
  285.      1' Suddenly a sinister, wraithlike figure appears before you'/
  286.      1' seeming to float in the air.  In a low, sorrowful voice he'/
  287.      2' says, "Alas, the very nature of the world has changed, and'/
  288.      3' the dungeon cannot be found.  All must now pass away."'/
  289.      4' Raising his oaken staff in farewell, he fades into the'/
  290.      5' spreading darkness.  In his place appears a tastefully'/
  291.      6' lettered sign reading:'//20X,'INITIALIZATION FAILURE'//
  292.      7' The darkness becomes all encompassing, and your vision fails.')
  293. C
  294.       END
  295.  
  296. C PROTCT-- Check for user violation
  297. C
  298. C This routine should be modified if you wish to add system
  299. c dependant protection against abuse.
  300. C
  301. C At the moment, play is permitted under all circumstances.
  302. C
  303.       LOGICAL FUNCTION PROTCT(X)
  304.       IMPLICIT INTEGER (A-Z)
  305. C
  306.       PROTCT=.TRUE.
  307.       RETURN
  308.       END
  309.